VERSION 5.00 Begin VB.Form frmAbout BorderStyle = 3 'Fixed Dialog Caption = "About " ClientHeight = 1176 ClientLeft = 48 ClientTop = 336 ClientWidth = 4644 ClipControls = 0 'False ControlBox = 0 'False LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 1176 ScaleWidth = 4644 ShowInTaskbar = 0 'False StartUpPosition = 2 'CenterScreen Tag = "About KF4ZPB Web Browser" Begin VB.CommandButton Exit Caption = "&OK" Height = 372 Left = 2880 TabIndex = 4 Top = 120 Width = 1692 End Begin VB.CommandButton SysInfo Caption = "&System Information" Height = 372 Left = 2880 TabIndex = 3 Top = 720 Width = 1692 End Begin VB.Label Label1 Caption = "This program is FREEWARE" Height = 372 Left = 120 TabIndex = 2 Top = 120 Width = 2652 End Begin VB.Label lblDescription Caption = "Viewing Website's and Webpage's" ForeColor = &H00000000& Height = 324 Left = 120 TabIndex = 1 Tag = "App Description" Top = 840 Width = 2652 End Begin VB.Label lblVersion Caption = "Version" Height = 348 Left = 120 TabIndex = 0 Tag = "Version" Top = 480 Width = 2652 End Attribute VB_Name = "frmAbout" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' Reg Key Security Options... Const KEY_ALL_ACCESS = &H2003F ' Reg Key ROOT Types... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Unicode nul terminated string Const REG_DWORD = 4 ' 32-bit number Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH" Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub Command1_Click() End Sub Private Sub info_Click() Msg = "Name: Carroll Dearstone ; E-Mail: cdearstone@yahoo.com ; Web Page: http://www.telery.com/kf4zpb/" MsgTitle = "Author's Contact Information" prompt = MsgBox(Msg, vbOKOnly, MsgTitle) Msg = "This program is protected by copyright laws. Warrenty Info: The author is not responsible for any damage done to your computer. It is distributed AS IS." MsgTitle = "Warning: Please read the following message." prompt = MsgBox(Msg, vbOKOnly, MsgTitle) End Sub Private Sub Form_Load() lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision End Sub Private Sub Exit_Click() Unload Me End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Try To Get System Info Program Path\Name From Registry... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Try To Get System Info Program Path Only From Registry... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Validate Existance Of Known 32 Bit File Version If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Error - File Can Not Be Found... Else GoTo SysInfoErr End If ' Error - Registry Entry Can Not Be Found... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '------------------------------------------------------------ ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error... tmpVal = String$(1024, 0) ' Allocate Variable Space KeyValSize = 1024 ' Mark Variable Size '------------------------------------------------------------ ' Retrieve Registry Key Value... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' Determine Key Value Type For Conversion... '------------------------------------------------------------ Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True ' Return Success rc = RegCloseKey(hKey) ' Close Registry Key Exit Function ' Exit GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" ' Set Return Val To Empty String GetKeyValue = False ' Return Failure rc = RegCloseKey(hKey) ' Close Registry Key End Function Private Sub SysInfo_Click() Call StartSysInfo End Sub